home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / PINBSRC.ZIP / _NORMVGA.PAS < prev    next >
Pascal/Delphi Source File  |  1996-02-02  |  7KB  |  332 lines
  1. { 320x200 _NORMVGA - (c) Ansgar Scherp, Joachim Gelhaus
  2.       all rights reserved / vt'95 }
  3. var
  4.   pal:array[0..255,1..3] of byte;
  5.  
  6. procedure video_mode(mode:byte);
  7. begin
  8.       asm
  9.         mov  AH,00
  10.         mov  AL,mode
  11.         int  10h
  12.       end;
  13. end;
  14.  
  15. procedure flip(src,dst:word); assembler; asm { copy virt scr to visual scr }
  16.   push ds; mov es,[dst]; mov ds,[src]; mov si,1
  17.   mov di,1; mov cx,32000; rep movsw; pop ds;
  18. end;
  19.  
  20. procedure set_rgb_color(color,red,green,blue:byte);
  21. begin
  22.     port[$3c8]:=color;
  23.     port[$3c9]:=red;
  24.     port[$3c9]:=green;
  25.     port[$3c9]:=blue;
  26. end;
  27.  
  28. procedure get_rgb_color(color,red,green,blue:byte);
  29. begin
  30.     port[$3c8]:=color;
  31.     red:=port[$3c9];
  32.     green:=port[$3c9];
  33.     blue:=port[$3c9];
  34. end;
  35.  
  36. procedure retrace; assembler; asm
  37.   mov dx,3dah; @vert1: in al,dx; test al,8; jz @vert1
  38.   @vert2: in al,dx; test al,8; jnz @vert2; end;
  39.  
  40. procedure cls(lvseg:word); assembler;
  41. asm
  42.   mov es,[lvseg]
  43.   xor di,di
  44.   xor ax,ax
  45.   mov cx,320*200/2
  46.   rep stosw
  47. end;
  48.  
  49.  
  50. procedure palette_black;
  51. var x:byte;
  52. begin
  53.   for x:=0 to 255 do set_RGB_COLOR(x,0,0,0);
  54. end;
  55.  
  56. procedure put_pixel(x,y:word; color:byte);
  57. begin
  58.      if (x>0) and (x<320) then mem[$A000:(320*y)+x]:=color;
  59. end;
  60.  
  61. function get_pixel(x,y:word):byte;
  62. begin
  63.      if (x>0) and (x<320) then get_pixel:=mem[$A000:(320*y)+x];
  64. end;
  65.  
  66. procedure load_palette(fname:string);
  67. var palfile:file of byte;
  68.     i,j:integer;
  69.     mfm:word;
  70. begin
  71.   mfm:=filemode;
  72.   filemode:=0;
  73.   if Pos('.',fname)=0 then fname:=fname+'.pal';
  74.   assign(palfile,fname);
  75.   {$I-}
  76.   reset(palfile);
  77.   {$I+}
  78.   for i:=0 to 255 do
  79.   begin
  80.     for j:=1 to 3 do
  81.     begin
  82.       read(palfile,pal[i,j]);
  83.     end;
  84.   end;
  85.   close(palfile);
  86.   filemode:=mfm;
  87.   port[$3c8]:=0;
  88.   {kleine eigenmächtige manipulation}
  89.   port[$3c9]:=0;port[$3c9]:=0;port[$3c9]:=0;
  90.   for i:=1{0} to 255 do
  91.   begin
  92.     port[$3c9]:=pal[i,1];
  93.     port[$3c9]:=pal[i,2];
  94.     port[$3c9]:=pal[i,3];
  95.   end;
  96. end;
  97.  
  98. procedure load_mini_palette(fname:string);
  99. var palfile:file of byte;
  100.     j:integer;
  101.     mfm:word;
  102.     colnr:byte;
  103.     b:byte;
  104. begin
  105.   mfm:=filemode;
  106.   filemode:=0;
  107.   if Pos('.',fname)=0 then fname:=fname+'.mpa';
  108.   assign(palfile,fname);
  109.   {$I-}
  110.   reset(palfile);
  111.   {$I+}
  112.   repeat
  113.     if not eof(palfile) then read(palfile,colnr);
  114.     port[$3c8]:=colnr;
  115.     for j:=1 to 3 do
  116.     begin
  117.       if not eof(palfile) then begin
  118.         read(palfile,b);
  119.         port[$3c9]:=b;
  120.       end;
  121.     end;
  122.   until eof(palfile);
  123.   close(palfile);
  124.   filemode:=mfm;
  125. end;
  126.  
  127. procedure load_palette_only(fname:string);
  128. var palfile:file of byte;
  129.     i,j:integer;
  130.     mfm:word;
  131. begin
  132.   mfm:=filemode;
  133.   filemode:=0;
  134.   if Pos('.',fname)=0 then fname:=fname+'.pal';
  135.   assign(palfile,fname);
  136.   {$I-}
  137.   reset(palfile);
  138.   {$I+}
  139.   for i:=0 to 255 do
  140.   begin
  141.     for j:=1 to 3 do
  142.     begin
  143.       read(palfile,pal[i,j]);
  144.     end;
  145.   end;
  146.   close(palfile);
  147.   filemode:=mfm;
  148. end;
  149.  
  150. procedure load_mini_palette_only(fname:string);
  151. var palfile:file of byte;
  152.     i,j:integer;
  153.     mfm:word;
  154.     colnr:byte;
  155. begin
  156.   mfm:=filemode;
  157.   filemode:=0;
  158.   if Pos('.',fname)=0 then fname:=fname+'.mpa';
  159.  
  160.   assign(palfile,fname);
  161.   {$I-}
  162.   reset(palfile);
  163.   {$I+}
  164.   repeat
  165.     if not eof(palfile) then read(palfile,colnr);
  166.     for j:=1 to 3 do
  167.     begin
  168.       if not eof(palfile) then read(palfile,pal[colnr,j]);
  169.     end;
  170.   until eof(palfile);
  171.   close(palfile);
  172.   filemode:=mfm;
  173. end;
  174.  
  175. procedure LOAD_VGA(fname:string);
  176. var f:file;
  177.     mfm:word;
  178. begin
  179.   mfm:=filemode;
  180.   filemode:=0;
  181.   assign(f,fname+'.VGA');
  182.   reset(f,1);
  183.   blockread(f,ptr($a000,0)^,64000);
  184.   close(f);
  185.   filemode:=mfm;
  186. end;
  187.  
  188. procedure PutSprite(x,y,h,b:word;spriteseg:word);
  189. var hoehe,breite:word;
  190. var spriteofs:word;
  191.     breitew:word;
  192.     scrofs:word;
  193.     scrseg:word;
  194. begin
  195.   breite:=b;
  196.   breitew:=b div 2;
  197.   spriteofs:=0;
  198.   scrseg:=$a000;
  199.   for hoehe:=y to y+h do
  200.   begin
  201.     scrofs:=hoehe*320+x;
  202.     asm
  203.       push ds;
  204.       mov es,scrseg;     {ES:DI}
  205.       mov ds,spriteseg; {DS:SI}
  206.       mov si,spriteofs;
  207.       mov di,scrofs;
  208.       mov cx,breitew;
  209.       rep movsw;
  210.       pop ds;
  211.     end;
  212.     inc(spriteofs,breite);
  213.   end;
  214. end;
  215.  
  216. procedure Scroll(x,y,x1,y1,h,b:word);
  217. var hoehe,breite:word;
  218. var spriteofs:word;
  219.     spriteseg:word;
  220.     breitew:word;
  221.     scrofs:word;
  222.     scrseg:word;
  223. begin
  224.   breite:=b;
  225.   breitew:=b div 2;
  226.   spriteofs:=0;
  227.   scrseg:=$a000;
  228.   spriteseg:=$a000;
  229.   for hoehe:=y1 to y1+h do
  230.   begin
  231.     spriteofs:=hoehe*320+x1;
  232.     scrofs:=y*320+x;
  233.     asm
  234.       push ds;
  235.       mov es,scrseg;     {ES:DI}
  236.       mov ds,spriteseg; {DS:SI}
  237.       mov si,spriteofs;
  238.       mov di,scrofs;
  239.       mov cx,breitew;
  240.       rep movsw;
  241.       pop ds;
  242.     end;
  243.     inc(y,1);
  244.   end;
  245. end;
  246.  
  247. procedure Palette_fade_in(fade_speed:byte);
  248. var r,g,b,i,c,p:byte;
  249.     pal_fade:array[0..255,1..3] of byte;
  250.     u:integer;
  251. begin
  252.   for i:=0 to 100 do
  253.   begin
  254.     for c:=0 to 255 do
  255.     begin
  256.       r:=trunc(pal[c,1] / 100 * i);
  257.       g:=trunc(pal[c,2] / 100 * i);
  258.       b:=trunc(pal[c,3] / 100 * i);
  259.       pal_fade[c,1]:=r;
  260.       pal_fade[c,2]:=g;
  261.       pal_fade[c,3]:=b;
  262.     end;
  263.     port[$3c8]:=0;
  264.     for p:=0 to 255 do
  265.     begin
  266.       port[$3c9]:=pal_fade[p,1];
  267.       port[$3c9]:=pal_fade[p,2];
  268.       port[$3c9]:=pal_fade[p,3];
  269.     end;
  270.     if i<99 then inc(i);
  271.     for p:=1 to fade_speed do retrace;
  272.   end;
  273. end;
  274.  
  275. procedure Palette_fade_out(fade_speed:byte;blackorwhite:byte);
  276. var r,g,b,i,c,p:byte;
  277.     pal_fade:array[0..255,1..3] of byte;
  278. begin
  279.   if blackorwhite=1 then begin
  280.     for i:=1 to 63 do begin
  281.       for c:=0 to 255 do begin
  282.         r:=pal[c,1];
  283.         g:=pal[c,2];
  284.         b:=pal[c,3];
  285.         if r<63 then inc(r);
  286.         if g<63 then inc(g);
  287.         if b<63 then inc(b);
  288.         pal[c,1]:=r;
  289.         pal[c,2]:=g;
  290.         pal[c,3]:=b;
  291.       end;
  292.       port[$3c8]:=0;
  293.       for p:=0 to 255 do begin
  294.         port[$3c9]:=pal[p,1];
  295.         port[$3c9]:=pal[p,2];
  296.         port[$3c9]:=pal[p,3];
  297.       end;
  298.       for p:=1 to fade_speed do retrace;
  299.     end;
  300.   end else begin
  301.     for i:=100 downto 0 do begin
  302.       for c:=0 to 255 do begin
  303.         r:=trunc(pal[c,1] / 100 * i);
  304.         g:=trunc(pal[c,2] / 100 * i);
  305.         b:=trunc(pal[c,3] / 100 * i);
  306.         pal_fade[c,1]:=r;
  307.         pal_fade[c,2]:=g;
  308.         pal_fade[c,3]:=b;
  309.       end;
  310.       if i>1 then dec(i);
  311.       for p:=1 to fade_speed do retrace;
  312.       port[$3c8]:=0;
  313.       for p:=0 to 255 do begin
  314.         port[$3c9]:=pal_fade[p,1];
  315.         port[$3c9]:=pal_fade[p,2];
  316.         port[$3c9]:=pal_fade[p,3];
  317.       end;
  318.     end;
  319.   end;
  320. end;
  321.  
  322. procedure palette_refresh;
  323. var c:byte;
  324. begin
  325.   for c:=0 to 255 do begin
  326.     port[$3c8]:=c;
  327.     pal[c,1]:=port[$3c9];
  328.     pal[c,2]:=port[$3c9];
  329.     pal[c,3]:=port[$3c9];
  330.   end;
  331. end;
  332.